home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / wsc4d21.zip / MODM_PGM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-06-05  |  11KB  |  443 lines
  1. unit Modm_pgm;
  2.  
  3. interface
  4.  
  5. uses
  6.   DisplayUnit,
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes,
  8.   Graphics, Controls,
  9.   Forms, Dialogs, Menus,
  10.   wsc, ExtCtrls, StdCtrls;
  11. type
  12.   TModm = class(TForm)
  13.     MainMenu: TMainMenu;
  14.     menuLine: TMenuItem;
  15.     menuOnLine: TMenuItem;
  16.     menuOffline: TMenuItem;
  17.     menuExit: TMenuItem;
  18.     menuChange: TMenuItem;
  19.     menuPort: TMenuItem;
  20.     menuBaud: TMenuItem;
  21.     menuDataBits: TMenuItem;
  22.     menuParity: TMenuItem;
  23.     menuStopBits: TMenuItem;
  24.     menuAbout: TMenuItem;
  25.     menuCOM1: TMenuItem;
  26.     menuCOM2: TMenuItem;
  27.     menuCOM3: TMenuItem;
  28.     menuCOM4: TMenuItem;
  29.     menu2400: TMenuItem;
  30.     menu9600: TMenuItem;
  31.     menu19200: TMenuItem;
  32.     menu38400: TMenuItem;
  33.     menu57600: TMenuItem;
  34.     menuSeven: TMenuItem;
  35.     menuEight: TMenuItem;
  36.     menuNone: TMenuItem;
  37.     menuEven: TMenuItem;
  38.     menuOdd: TMenuItem;
  39.     menuOne: TMenuItem;
  40.     menuTwo: TMenuItem;
  41.     Timer: TTimer;
  42.     AboutPanel: TPanel;
  43.     AboutOK: TButton;
  44.     AboutMemo: TMemo;
  45.     menuStatus: TMenuItem;
  46.     menuControl: TMenuItem;
  47.     menuFlowControl: TMenuItem;
  48.     menuHardware: TMenuItem;
  49.     menuSoftware: TMenuItem;
  50.     menuNoFlow: TMenuItem;
  51.     menuDTR: TMenuItem;
  52.     menuRTS: TMenuItem;
  53.     menuDTRset: TMenuItem;
  54.     menuDTRclear: TMenuItem;
  55.     menuRTSset: TMenuItem;
  56.     menuRTSclear: TMenuItem;
  57.     Memo: TMemo;
  58.     procedure FormCreate(Sender: TObject);
  59.     procedure menuOnLineClick(Sender: TObject);
  60.     procedure menuOfflineClick(Sender: TObject);
  61.     procedure menuCOM1Click(Sender: TObject);
  62.     procedure menuCOM2Click(Sender: TObject);
  63.     procedure menuCOM3Click(Sender: TObject);
  64.     procedure menuCOM4Click(Sender: TObject);
  65.     procedure menuExitClick(Sender: TObject);
  66.     procedure menu2400Click(Sender: TObject);
  67.     procedure menu9600Click(Sender: TObject);
  68.     procedure menu19200Click(Sender: TObject);
  69.     procedure menu38400Click(Sender: TObject);
  70.     procedure menu57600Click(Sender: TObject);
  71.     procedure menuSevenClick(Sender: TObject);
  72.     procedure menuEightClick(Sender: TObject);
  73.     procedure menuNoneClick(Sender: TObject);
  74.     procedure menuEvenClick(Sender: TObject);
  75.     procedure menuOddClick(Sender: TObject);
  76.     procedure menuOneClick(Sender: TObject);
  77.     procedure menuTwoClick(Sender: TObject);
  78.     procedure TimerTimer(Sender: TObject);
  79.     procedure KeyPress(Sender: TObject; var Key: Char);
  80.     procedure menuAboutClick(Sender: TObject);
  81.     procedure Status(Sender: TObject);
  82.     procedure AboutOKClick(Sender: TObject);
  83.     procedure menuDTRsetClick(Sender: TObject);
  84.     procedure menuRTSsetClick(Sender: TObject);
  85.     procedure menuDTRclearClick(Sender: TObject);
  86.     procedure menuRTSclearClick(Sender: TObject);
  87.     procedure menuHardwareClick(Sender: TObject);
  88.     procedure menuSoftwareClick(Sender: TObject);
  89.     procedure menuNoFlowClick(Sender: TObject);
  90.   private
  91.     { Private declarations }
  92.     Port : Integer;
  93.     Baud : Integer;
  94.     Parity : Integer;
  95.     DataBits : Integer;
  96.     StopBits : Integer;
  97.   public
  98.     { Public declarations }
  99.   end ;
  100.  
  101. var
  102.   Modm: TModm;
  103.  
  104. implementation
  105.  
  106. {$R *.DFM}
  107.  
  108. procedure TModm.FormCreate(Sender: TObject);
  109. var
  110.   I    : Integer;
  111.   Code : Integer;
  112. begin
  113.   (* initialize parameters *)
  114.   Port := COM1;
  115.   Baud := Baud19200;
  116.   Parity := NoParity;
  117.   DataBits := WordLength8;
  118.   StopBits := OneStopBit;
  119.   (* initialize menu settings *)
  120.   menuOffLine.Checked := true;
  121.   menuCOM1.Checked := true;
  122.   menu19200.Checked := true;
  123.   menuNone.Checked := true;
  124.   menuEight.Checked := true;
  125.   menuOne.Checked := true
  126. end;
  127.  
  128. procedure TModm.menuOnLineClick(Sender: TObject);
  129. var
  130.   Code : Integer;
  131. begin
  132.   (* initialize WSC *)
  133.   Code := SioReset(Port,1024,512);
  134.   if Code < 0 then begin
  135.     DisplayString(Memo,Format('Error %d: ',[Code]));
  136.     DisplayError(Memo, Code);
  137.     exit
  138.   end;
  139.   (* update menu settings *)
  140.   Modm.Caption := 'Modem: COM' + Chr($31+Port) + ' Online';
  141.   menuOnLine.Checked := true;
  142.   menuOffLine.Checked := false;
  143.   menuChange.Enabled := false;
  144.   menuStatus.Enabled := true;
  145.   menuControl.Enabled := true;
  146.   menuFlowControl.Enabled := true;
  147.   menuNoFlow.Checked := true;
  148.   Code := SioBaud(Port,Baud);
  149.   Code := SioParms(Port, Parity, StopBits, DataBits);
  150.   Code := SioDTR(Port,'S');
  151.   Code := SioRTS(Port,'S');
  152.   Code := SioFlow(Port,'N')
  153. end;
  154.  
  155. procedure TModm.menuOfflineClick(Sender: TObject);
  156. var
  157.   Code : Integer;
  158. begin
  159.   Modm.Caption := 'Modem: Offline';
  160.   DisplayString(Memo,'Shutting down COM port');
  161.   menuOnLine.Checked := false;
  162.   menuOffLine.Checked := true;
  163.   menuChange.Enabled := true;
  164.   menuStatus.Enabled := false;
  165.   menuControl.Enabled := false;
  166.   menuFlowControl.Enabled := false;
  167.   Code := SioDone(Port)
  168. end;
  169.  
  170. procedure TModm.menuCOM1Click(Sender: TObject);
  171. begin
  172.   menuCOM1.Checked := true;
  173.   menuCOM2.Checked := false;
  174.   menuCOM3.Checked := false;
  175.   menuCOM4.Checked := false;
  176.   Port := COM1
  177. end;
  178.  
  179. procedure TModm.menuCOM2Click(Sender: TObject);
  180. begin
  181.   menuCOM1.Checked := false;
  182.   menuCOM2.Checked := true;
  183.   menuCOM3.Checked := false;
  184.   menuCOM4.Checked := false;
  185.   Port := COM2
  186. end;
  187.  
  188. procedure TModm.menuCOM3Click(Sender: TObject);
  189. begin
  190.   menuCOM1.Checked := false;
  191.   menuCOM2.Checked := false;
  192.   menuCOM3.Checked := true;
  193.   menuCOM4.Checked := false;
  194.   Port := COM3
  195. end;
  196.  
  197. procedure TModm.menuCOM4Click(Sender: TObject);
  198. begin
  199.   menuCOM1.Checked := false;
  200.   menuCOM2.Checked := false;
  201.   menuCOM3.Checked := false;
  202.   menuCOM4.Checked := true;
  203.   Port := COM4
  204. end;
  205.  
  206. procedure TModm.menuExitClick(Sender: TObject);
  207. var
  208.   Code : Integer;
  209. begin
  210.   Code := SioDone(Port);
  211.   Application.Terminate;
  212. end;
  213.  
  214. procedure TModm.menu2400Click(Sender: TObject);
  215. begin
  216.   menu2400.Checked := true;
  217.   menu9600.Checked := false;
  218.   menu19200.Checked := false;
  219.   menu38400.Checked := false;
  220.   menu57600.Checked := false;
  221.   Baud := Baud2400
  222. end;
  223.  
  224. procedure TModm.menu9600Click(Sender: TObject);
  225. begin
  226.   menu2400.Checked := false;
  227.   menu9600.Checked := true;
  228.   menu19200.Checked := false;
  229.   menu38400.Checked := false;
  230.   menu57600.Checked := false;
  231.   Baud := Baud9600
  232. end;
  233.  
  234. procedure TModm.menu19200Click(Sender: TObject);
  235. begin
  236.   menu2400.Checked := false;
  237.   menu9600.Checked := false;
  238.   menu19200.Checked := true;
  239.   menu38400.Checked := false;
  240.   menu57600.Checked := false;
  241.   Baud := Baud19200
  242. end;
  243.  
  244. procedure TModm.menu38400Click(Sender: TObject);
  245. begin
  246.   menu2400.Checked := false;
  247.   menu9600.Checked := false;
  248.   menu19200.Checked := false;
  249.   menu38400.Checked := true;
  250.   menu57600.Checked := false;
  251.   Baud := Baud38400
  252. end;
  253.  
  254. procedure TModm.menu57600Click(Sender: TObject);
  255. begin
  256.   menu2400.Checked := false;
  257.   menu9600.Checked := false;
  258.   menu19200.Checked := false;
  259.   menu38400.Checked := false;
  260.   menu57600.Checked := true;
  261.   Baud := Baud57600
  262. end;
  263.  
  264. procedure TModm.menuSevenClick(Sender: TObject);
  265. begin
  266.   menuSeven.Checked := true;
  267.   menuEight.Checked := false;
  268.   DataBits := WordLength7
  269. end;
  270.  
  271. procedure TModm.menuEightClick(Sender: TObject);
  272. begin
  273.   menuSeven.Checked := false;
  274.   menuEight.Checked := true;
  275.   DataBits := WordLength8
  276. end;
  277.  
  278. procedure TModm.menuNoneClick(Sender: TObject);
  279. begin
  280.   menuNone.Checked := true;
  281.   menuEven.Checked := false;
  282.   menuOdd.Checked := false;
  283.   Parity := NoParity
  284. end;
  285.  
  286. procedure TModm.menuEvenClick(Sender: TObject);
  287. begin
  288.   menuNone.Checked := false;
  289.   menuEven.Checked := true;
  290.   menuOdd.Checked := false;
  291.   Parity := EvenParity
  292. end;
  293.  
  294. procedure TModm.menuOddClick(Sender: TObject);
  295. begin
  296.   menuNone.Checked := false;
  297.   menuEven.Checked := false;
  298.   menuOdd.Checked := true;
  299.   Parity := OddParity
  300. end;
  301.  
  302. procedure TModm.menuOneClick(Sender: TObject);
  303. begin
  304.   menuOne.Checked := true;
  305.   menuTwo.Checked := false;
  306.   StopBits := OneStopBit
  307. end;
  308.  
  309. procedure TModm.menuTwoClick(Sender: TObject);
  310. begin
  311.   menuOne.Checked := false;
  312.   menuTwo.Checked := true;
  313.   StopBits := TwoStopBits
  314. end;
  315.  
  316. procedure TModm.KeyPress(Sender: TObject; var Key: Char);
  317. var
  318.   Code : Integer;
  319. begin
  320.   Code := SioPutc(Port,Key);
  321. end;
  322.  
  323. procedure TModm.TimerTimer(Sender: TObject);
  324. var
  325.   I, Code : Integer;
  326.   S : String;
  327.   CharCount : Integer;
  328. begin
  329.   S  := '';
  330.   CharCount := 0;
  331.   {Gather all incoming}
  332.   for I := 1 to 128 do
  333.     begin
  334.       Code := SioGetc(Port);
  335.       if Code < 0 then break;
  336.       if Chr(Code) <> Chr(13) then begin
  337.         {got character (other than CR)}
  338.         Inc(CharCount);
  339.         if Chr(Code) = Chr(10) then break;
  340.         S := S + Chr(Code);
  341.       end
  342.     end; {for}
  343.   {display}
  344.    if CharCount > 0 then DisplayString(Memo,S);
  345.    if Chr(Code) = Chr(10) then DisplayChar(Memo,Chr(10))
  346. end;
  347.  
  348. procedure TModm.menuAboutClick(Sender: TObject);
  349. begin
  350.    AboutPanel.Visible := True
  351. end;
  352.  
  353. procedure TModm.Status(Sender: TObject);
  354. var
  355.   Code : Integer;
  356.   Text : String;
  357. begin
  358.   if SioDSR(Port) = 0 then DisplayLine(Memo,'[DSR is clear]')
  359.   else DisplayLine(Memo,'[DSR is set]');
  360.   if SioCTS(Port) = 0 then DisplayLine(Memo,'[CTS is clear]')
  361.   else DisplayLine(Memo,'[CTS is set]');
  362.   Code := SioStatus(Port,$ffff);
  363.   (* DisplayLine(Format('%x',[Code])) *)
  364.   if(WSC_RXOVER AND Code) <> 0 then DisplayLine(Memo,'[RX queue overflow]');
  365.   if(WSC_OVERRUN AND Code) <> 0 then DisplayLine(Memo,'[UART overrun]');
  366.   if(WSC_FRAME AND Code) <> 0 then DisplayLine(Memo,'[Framing error]');
  367.   if(WSC_BREAK AND Code) <> 0 then DisplayLine(Memo,'[BREAK detected]');
  368.   if(WSC_TXFULL AND Code) <> 0 then DisplayLine(Memo,'[TX queue full]')
  369. end;
  370.  
  371. procedure TModm.AboutOKClick(Sender: TObject);
  372. begin
  373.    AboutPanel.Visible := False
  374. end;
  375.  
  376. procedure TModm.menuDTRsetClick(Sender: TObject);
  377. var
  378.   Code : Integer;
  379. begin
  380.   Code := SioDTR(Port,'S');
  381.   menuDTRset.Checked := true;
  382.   menuDTRclear.Checked := false
  383. end;
  384.  
  385. procedure TModm.menuRTSsetClick(Sender: TObject);
  386. var
  387.   Code : Integer;
  388. begin
  389.   Code := SioRTS(Port,'S');
  390.   menuRTSset.Checked := true;
  391.   menuRTSclear.Checked := false
  392. end;
  393.  
  394. procedure TModm.menuDTRclearClick(Sender: TObject);
  395. var
  396.   Code : Integer;
  397. begin
  398.   Code := SioDTR(Port,'C');
  399.   menuDTRclear.Checked := true;
  400.   menuDTRset.Checked := false
  401. end;
  402.  
  403. procedure TModm.menuRTSclearClick(Sender: TObject);
  404. var
  405.   Code : Integer;
  406. begin
  407.   Code := SioRTS(Port,'C');
  408.   menuRTSclear.Checked := true;
  409.   menuRTSset.Checked := false
  410. end;
  411.  
  412. procedure TModm.menuHardwareClick(Sender: TObject);
  413. var
  414.   Code : Integer;
  415. begin
  416.   Code := SioFlow(Port,'H');
  417.   menuHardware.Checked := true;
  418.   menuSoftware.Checked := false;
  419.   menuNoFlow.Checked := false
  420. end;
  421.  
  422. procedure TModm.menuSoftwareClick(Sender: TObject);
  423. var
  424.   Code : Integer;
  425. begin
  426.   Code := SioFlow(Port,'S');
  427.   menuHardware.Checked := false;
  428.   menuSoftware.Checked := true;
  429.   menuNoFlow.Checked := false
  430. end;
  431.  
  432. procedure TModm.menuNoFlowClick(Sender: TObject);
  433. var
  434.   Code : Integer;
  435. begin
  436.   Code := SioFlow(Port,'N');
  437.   menuHardware.Checked := false;
  438.   menuSoftware.Checked := false;
  439.   menuNoFlow.Checked := true
  440. end;
  441.  
  442. end.
  443.